home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Yerk 3.6.8 / Module source / atool < prev    next >
Encoding:
Text File  |  1995-11-13  |  6.4 KB  |  220 lines  |  [TEXT/YERK]
  1. \ Construct table of names & traps for toolbox calls
  2. \ Modification History
  3. \  4/23/84  CBD Version 1.0
  4. \ 12/29/85  cdn Improved asmCall to accept upper/lower case
  5. \  6/11/86  cdn Added Mac Plus toolbox calls; generally improved code
  6. \  6/28/86  cdn Added call Pack routines by name
  7. \  7/01/86  ndc Added hash collision resolution
  8. \  8/28/86  cdn Added fcall
  9. \  9/03/86  rfd Modified Tools" for HFS compatability (no reopen)
  10. \  6/16/87    rfl    Added calls for MacII
  11. \  8/28/88    rfl increased collision table to 10 bytes because of
  12. \                confusion with dispospixmap and dispospixpat ETC.
  13. \                Make sure to vary name,trap,parm,pibx, and ctable sizes
  14. \                Also, all traps must be in one text file to be read in
  15. \ 8/31/88    rfl changed allot to reserve to fix error in modulation
  16. \                the second pass must equal the first pass in data errors
  17. \                or else the module code will figure the difference is an addr
  18. \                which must be relocated
  19. \ 9/19/88    rfl    added popupmenu traps
  20. \ 10/07/89    rfl increase to 1000 and 120
  21. \  8/13/90    rfl modify sizes
  22. \ 12/15/90    rfl    moved gtool here
  23. \  2/07/91    rfl    increased globals
  24. \  2/17/91    rfl    modified for use with Michael Hore's 32bit hash routine.
  25. \                collisions are VERY rare.
  26. \  7/02/91    rfl    allow hex values for parms
  27. \ 10/25/91    rfl    fixed occasional bug in hex value code
  28. \ 11/9/95    rfl ok, really modified to use data files in the yerk folder that
  29. \                  hold the trap hashes and inline codes, so the module doesn't
  30. \                  exceed the 32k limit.
  31.  
  32. Decimal
  33.  
  34. :Module Tool1
  35.  
  36. 0 value names
  37. sarray inLines
  38.  
  39. hex
  40. \ ( str255addr -- hashVal )  hash a  name into a 32-bit word
  41. create HashName 
  42.     2057    w,    \        move.l    (sp),a0
  43.     d1cb    w,    \        adda.l    a3,a0
  44.     7000    w,    \        moveq    #0,d0        \ Result will go to D0
  45.     7400    w,    \        moveq    #0,d2
  46.     1418    w,    \        move.b    (a0)+,d2    \ Count
  47.     c43c007f ,    \        and.b    #127,d2        \ Clear top bit in case it's a name field
  48.     60000008 ,    \        bra        lptest
  49.     ef98    w,    \ loop    rol.l    #7,d0
  50.     1218    w,    \        move.b    (a0)+,d1
  51.     b300    w,    \        eor.b    d1,d0        \ b300
  52.     51cafff8 ,    \ lptest dbra    d2,loop
  53.     08c0001f ,    \        bset    #31,d0
  54.     2e80    w,    \        move.l    d0,(sp)
  55. next,
  56. decimal
  57.  
  58. ( str255 chr -- offs t OR f )
  59. : charOf { addr chr \ flag -- } false -> flag
  60.     addr c@ 0 1 ++> addr
  61.     DO
  62.         addr i+ c@ chr = IF  i  true -> flag leave THEN
  63.     LOOP flag
  64. ;
  65.  
  66.  
  67. : load new: inLines
  68.     new: loadfile " trapHash" name: topfile
  69.     openReadOnly: topfile abort" open Error"
  70.     0 sp@ 4 read: topfile drop heap> ordered-col -> names
  71.     names length: names read: topfile drop
  72.     close: topfile drop
  73.     " InLines" name: topfile
  74.     openReadOnly: topfile abort" open error"
  75.     0 sp@ 4 read: topfile drop putLimit: inLines
  76.     topfile size: topfile 4 - read: inlines drop
  77.      remove: loadfile 
  78. \    lock: inlines get: inlines scount putLimit: inlines
  79.     size: names limit: inlines <> abort" sizes don't match"  ;
  80.  
  81. true value notLoaded?
  82.  
  83. : endTool dispose> names release: inlines true -> notLoaded? ;
  84.  
  85. : findTrap { addr len \ flag -- addr' } false -> flag
  86.     addr addr len + 2-
  87.     DO ic@ $ F0 and $ A0 = IF i true -> flag LEAVE THEN -2 +LOOP 
  88.     flag ;
  89.  
  90. \ ( str255 -- addr len )  Get Trap word for a call index
  91. : @Trap { tStr \ mStr addr len idx amod -- } 0 -> mStr 0 -> amod
  92.     tStr ascii , charOf                    \ stop short of comma if any
  93.     IF dup tStr c! tStr + 2+ -> mStr THEN
  94.     tStr HashName indexOf: names 0= ?error 150
  95.     -> idx idx  at: inLines -> len -> addr
  96.     mStr    \ modifier bits if any
  97.     IF    " REGS"  mstr over    s= IF $ 01 -> amod THEN    \ GetTrapAddr
  98.         " ASYNC" mstr over    s= IF $ 04 -> amod THEN    \ device drivers
  99.         " IMMED  mstr over    s= IF $ 02 -> amod THEN    \ control calls
  100.         " SYS"   mstr over    s= IF $ 04 -> amod THEN    \ Memory Manager
  101.         " CLEAR" mstr over    s= IF $ 02 -> amod THEN
  102.         " MARKS" mstr over    s= IF $ 04 -> amod THEN    \ String Compares
  103.         " CASE"  mstr over    s= IF $ 02 -> amod THEN
  104.         amod 0= ?error 193
  105.         addr len findTrap not   ?error 193    \ modifiers will now work with this type
  106.         addr - pad + -> idx
  107.         addr pad len cmove
  108.         amod idx c@ or idx c!
  109.         pad -> addr
  110.     THEN
  111.     addr len ;
  112.  
  113. hex
  114. create trapJmp
  115.     205f w,    \    move.l    (sp)+,a0
  116.     d1cb w,    \    adda.l    a3,a0
  117.     4ed0 w,    \    jmp    (a0)
  118. next,
  119. decimal
  120. \ used for traps from interpreter
  121. : ttrapw <builds 40 reserve does>  cflush trapJmp ;
  122. ttrapw trapper
  123.  
  124. 'c trapper 8+ value ^trapper
  125. \ 
  126. : tw, ( addr n -- addr') swap >r r w! r> 2+ ;
  127.  
  128. : call1 notLoaded? IF load false -> notLoaded? THEN
  129.     @word @trap                    \ get addr len of trap inline
  130.     state                            \ is it compile state?
  131.     IF compile inLine                \ yes, so compile 'inLine' to start a code word
  132.         here over allot swap cmove    \ compile inline code at here
  133.         $ 49fA0006 ,                \ lea *+8,a4 to reset IP to follow the code
  134.         compile next,                \ next, to end the code word
  135.     ELSE ^trapper swap >r r cmove         \ fill interp trap field with inline and save len
  136.             ^trapper r> + $ 4eeb tw, next tw,    \ add next,
  137.             drop trapper                        \ drop addr from tw, and execute
  138.     THEN ; immediate                \ interp resumes here
  139.  
  140. : asmcall1 notLoaded? IF load false -> notLoaded? THEN
  141.     str255 1+ buf255 c@ >uc
  142.     buf255 @Trap
  143.     here over allot swap cmove ;
  144.  
  145. : fcall1 ( fcb --) state
  146.     IF compile >r compile word0 compile r> compile +base ELSE >r word0 r> +base THEN
  147.     [compile] call1 state IF compile i->l ELSE i->l THEN ; immediate
  148.  
  149. \ 
  150. \ \ Trap dispatcher for low-level File Manager
  151. \ : fCall
  152. \     @word @Trap
  153. \     State
  154. \     IF    Compile Lit
  155. \         IF ELSE 0 THEN
  156. \         w, w, Compile (fdos)
  157. \     ELSE IF makeInt THEN
  158. \         (fdos)
  159. \     THEN
  160. \ ; Immediate
  161. \ 
  162. \ 
  163. \ ************
  164.  
  165. 182 ordered-col gNames
  166. 182 wordCol globals
  167.  
  168.  
  169. \ ( -- )   Get next word, add if global name
  170. : globalName
  171.     @word hex number drop            ( global addr )
  172.     @word
  173.     HashName dup indexOf: gNames        ( trap# hashval [idx] bool )
  174.     IF   . abort" collision"        \ mark collision item
  175.     ELSE add: gNames add: globals
  176.     THEN ;
  177.  
  178. \ read toolbox name/trap table and fill arrays
  179. : Tools" { \ radix cecho -- }
  180.     1 tface ." Loading globals…" 0 tface
  181.     base -> radix  decho -> cecho
  182.     new: loadFile setName: topFile
  183.     openReadOnly: topFile ?error 149
  184.  
  185.         0 moveTo: topFile drop
  186.         query: topFile drop
  187.          BEGIN                    \ read until eof
  188.             tib c@ ascii \ <>    \ skip comments
  189.             IF  globalName THEN 
  190.             query: topFile
  191.         UNTIL
  192.         -echo
  193.  
  194.     remove: loadFile
  195.     radix -> base  cecho -> decho ;
  196.  
  197. \ load the calls into the symbol table
  198. Tools" ::Module source:globals
  199. forget globalName    \ dump table generation code
  200.  
  201. CR
  202. size: globals  . ." routine gNames stored" CR
  203.  
  204. \ ( str255 -- global )  Get global word for a global index
  205. : @global { tStr -- }
  206.     tStr HashName indexOf: gNames  0= ?error 150
  207.     dup ^elem: globals w@                    ( idx trap/flag )
  208.     swap drop ;
  209.  
  210. \ global dispatcher
  211. : global1
  212.     @word @global
  213.     state 
  214.     IF  compile lit , 'c -base ,
  215.     ELSE  -base
  216.     THEN 
  217. ; Immediate
  218.  
  219. ;Module
  220.